unit WebModuleUnit;

interface

uses System.SysUtils, System.Classes, IPPeerServer, Web.HTTPApp, Web.HTTPProd,
  Datasnap.DSCommonServer, Datasnap.DSHTTP, Datasnap.DSHTTPWebBroker,
  Datasnap.DSServer, Datasnap.DSAuth, IdHTTPWebBrokerBridge,
  Datasnap.DSHTTPCommon;


type
  TwvWebModule = class(TWebModule)
    DSHTTPWebDispatcher: TDSHTTPWebDispatcher;
    ReverseString: TPageProducer;
    WebFileDispatcher: TWebFileDispatcher;
    procedure ServerFunctionInvokerHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: string; TagParams: TStrings; var ReplaceText: string);
    procedure WebModuleDefaultAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure WebModuleCreate(Sender: TObject);
  private
  public
    constructor CreateRT(AOwner: TComponent; AAppServer: TObject);
    destructor Destroy; override;
  class var
    FAppServer: TObject;
    HTTPServer: TIdHTTPWebBrokerBridge;
  end;

var
  WebModuleClass: TComponentClass = TwvWebModule;

implementation

uses uServerMethods, u1cAgentServer, Web.WebReq, Datasnap.DSSession, Winapi.ActiveX;

{$R *.dfm}

constructor TwvWebModule.CreateRT(AOwner: TComponent; AAppServer: TObject);
begin
  if WebRequestHandler <> nil then
    WebRequestHandler.WebModuleClass := TwvWebModule;

  inherited Create(AOwner);

  FAppServer:= AAppServer;

  if HTTPServer = nil then begin
    HTTPServer:= TIdHTTPWebBrokerBridge.Create(nil);
    HTTPServer.Bindings.Clear;
    //FHTTPServer.DefaultPort := StrToInt(EditPort.Text);
    //FHTTPServer.Active := True;
  end;

end;

destructor TwvWebModule.Destroy;
begin
  inherited;
end;

procedure TwvWebModule.ServerFunctionInvokerHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: string; TagParams: TStrings; var ReplaceText: string);
begin
  if SameText(TagString, 'urlpath') then
    ReplaceText := string(Request.InternalScriptName)
  else if SameText(TagString, 'port') then
    ReplaceText := IntToStr(Request.ServerPort)
  else if SameText(TagString, 'host') then
    ReplaceText := string(Request.Host)
  else if SameText(TagString, 'classname') then
    ReplaceText := uServerMethods.TGate1C.ClassName
  else if SameText(TagString, 'loginrequired') then
    if (DSHTTPWebDispatcher.AuthenticationManager <> nil) and (T1CAppServer(FAppServer).ConPassword <> EmptyStr) then
      ReplaceText := 'true'
    else
      ReplaceText := 'false'
  else if SameText(TagString, 'serverfunctionsjs') then
    ReplaceText := string(Request.InternalScriptName) + '/js/serverfunctions.js'
  else if SameText(TagString, 'servertime') then
    ReplaceText := DateTimeToStr(Now)
  else if SameText(TagString, 'serverfunctioninvoker') then
    ReplaceText := '';
end;

procedure TwvWebModule.WebModuleDefaultAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  if (Request.InternalPathInfo = '') or (Request.InternalPathInfo = '/')then
    Response.Content := ReverseString.Content
  else
    Response.SendRedirect(Request.InternalScriptName + '/');
end;

procedure TwvWebModule.WebModuleCreate(Sender: TObject);
begin
  DSHTTPWebDispatcher.Server := T1CAppServer(FAppServer)._dsServer;
//  DSServerMetaDataProvider1.Server:= T1CAppServer(FAppServer)._dsServer;
  if DSHTTPWebDispatcher.Server.Started then
  begin
    DSHTTPWebDispatcher.DbxContext := DSHTTPWebDispatcher.Server.DbxContext;
    DSHTTPWebDispatcher.Start;
  end;
  DSHTTPWebDispatcher.AuthenticationManager := T1CAppServer(FAppServer)._dsAuthenticationManager;

  CoUninitialize();
  CoInitializeEx(nil, COINIT_MULTITHREADED);
end;

initialization
begin
  TwvWebModule.FAppServer:= nil;
  TwvWebModule.HTTPServer:= nil;
end;

finalization
begin
  FreeAndNil(TwvWebModule.HTTPServer);
  if TDSSessionManager.Instance <> nil then
    TDSSessionManager.Instance.TerminateAllSessions;
end;

end.

